PC Answers 1995 May/PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso/vbits/code/pleas/ole/visio/network/main.bas

BASIC Source File | 1994-05-18 | 17.0 KB | 586 lines

'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'--
'--                        Network Diagramming Example
'--                       (C)1993 Shapeware Corporation
'--
'--   File Name : main.bas
'--
'-- Description :
'--
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------

'This file contains sample code for using Visual Basic and OLE 2.0 to
'automatically create a Visio network diagram from a Microsoft Access
'database.
'
'IMPORTANT:  NETVB.ZIP is ONLY a sample, not a released product.  It was
'not extensively tested, and has no guarantee.  In addition, we do not provide
'documentation or support for this file.
'
'After you download and unzip the file, read the file "abstract.wri" to get
'more information about what you need before running the file.
'
'To run the file*, open your Windows File Manager, go to the directory where
'you placed the unzipped files, and double-click the file "netdiag.mak."  This
'will open Visual Basic.  Press F5 to run the program.  The program will run,
'and from its File menu, choose Open Database.  Then choose "network.mdb"
'which is included in NETVB.ZIP and watch your blank Visio drawing page
'turn into a basic network diagram!
'
'*It doesn't matter if you already have Visio running.  If it is, that instance
'will be used.  If not, the program will start it.
'

Option Explicit
Option Base 0

'--
'-- Win 3.1 API Helpers
'--

Global Const OFN_HIDEREADONLY = &H4&
Global Const OFN_OVERWRITEPROMPT = &H2&

Global Const IDYES = 6
Global Const IDNO = 7

Global Const MB_YESNO = 4
Global Const MB_ICONQUESTION = 32
Global Const MB_ICONEXCLAMATION = 48
Global Const MB_ICONINFORMATION = 64

'--
'-- Network diagram constants
'--

Global Const NDB_NET_TABLE_NAME = "NETWORK"
Global Const NDB_NET_TABLE_INDEX = "NET_INFO_IDX"

Global Const NDB_NET_TABLE_NODE = "Node Type"
Global Const NDB_NET_TABLE_TEXT = "Text"
Global Const NDB_NET_TABLE_DATA1 = "Data1"
Global Const NDB_NET_TABLE_DATA2 = "Data2"

Global Const NDB_PAGE_WIDTH = 3
Global Const NDB_PAGE_HEIGHT = 5

'-- Network Stencil Constants

Global Const NDB_NET_TEMPLATE = "network.vst"
Global Const NDB_NET_STENCIL = "network.vss"

Global Const NDB_NET_ETHERNET = "Ethernet"
Global Const NDB_NET_BUS = "Bus"
Global Const NDB_NET_STAR = "Star"
Global Const NDB_NET_TOKEN_RING = "Token-ring"
Global Const NDB_NET_FDDI_RING = "FDDI ring"

Global Const NDB_NODE_MAC = "Macintosh"
Global Const NDB_NODE_PC = "Desktop PC"
Global Const NDB_NODE_SERVER = "Server"
Global Const NDB_NODE_WORKSTATION = "Workstation"
Global Const NDB_NODE_TOWER = "Server / tower"
Global Const NDB_NODE_PRINTER = "Printer"

'--
'-- Module variables used by CreateDiagram and it's support functions.
'--

Dim m_tblNetInfo As Table

Dim m_pag As Object
Dim m_masts As Object


'--
'--   To place nodes on the diagram effectively we need to know a little about
'-- them first.  This structure keeps the shapes unique NameID, pin and
'-- network connection point.
'--

Type NodeInfo
    ' Name of Master (See MatchMasterToType)
    '
    strMaster As String

    ' Used when dropping shape on page.
    '
    iPinX As Double
    iPinY As Double

    ' Side of shape that should be glued to.   See SIDE contstants in
    ' VISSHEET.BAS
    '
    iSide As Integer
End Type

Sub BuildNodeList (Nodes() As NodeInfo)
'----------------------------------------
'--- BuildNodeList ----------------------
'--
'--   Constructs a node list depending the contents of the network info table.
'--

    Dim iNode As Integer, iNodes As Integer
    Dim iPinX, iPinY

    iNode = 0: iNodes = 0

    ' First we loop through the table and count the number of records.
    '
    m_tblNetInfo.MoveFirst

    Do While Not m_tblNetInfo.EOF
        iNodes = iNodes + 1
        m_tblNetInfo.MoveNext
    Loop

    ' Next we check the size of the table and, if no records exists, exit.
    ' Otherwise we allocate the array.
    '
    If iNodes = 0 Then Exit Sub

    ReDim Nodes(0 To Min(iNodes, 8) - 1)

    ' Loop through the database and fill out each node structure.
    '
    m_tblNetInfo.MoveFirst

    iPinX = .5
    iPinY = .5

    While Not m_tblNetInfo.EOF And (iNode < (UBound(Nodes) + 1))
        ' Each node must have a unique master type assigned, it's pin computed
        ' dependent upon which column it resides in and it's proper
        ' connection point side determined.  The connect side is used with
        ' BestExportPoint at draw time to glue to the network bus.
        '
        Nodes(iNode).strMaster = MatchMasterToType(m_tblNetInfo.Fields(0))

        Nodes(iNode).iPinX = iPinX
        Nodes(iNode).iPinY = iPinY

        If iNode < 4 Then
            Nodes(iNode).iSide = SIDE_RIGHT
        Else
            Nodes(iNode).iSide = SIDE_LEFT
        End If

        If iNode = 3 Then
            iPinX = NDB_PAGE_WIDTH - .5
            iPinY = .5
        Else
            iPinY = iPinY + 1.25
        End If

        iNode = iNode + 1
        m_tblNetInfo.MoveNext
    Wend
End Sub

Sub CreateBlankDatabase (strFileName As String)
'----------------------------------------
'--- CreateBlankDatabase ----------------
'--
'--   Builds a blank Access database for the user.  Assumes the file name passed
'-- does not exists.
'--

    On Error GoTo lblNewDBaseErr

    Dim fldNode As New Field, fldText As New Field
    Dim fldData1 As New Field, fldData2 As New Field
    Dim dbDBase As Database, tblNetInfo As New TableDef, tblIndex As New Index

    ' First we create the database
    '
    Set dbDBase = CreateDatabase(strFileName, DB_LANG_GENERAL, DB_VERSION10)

    ' Initialize the table index to the node field.
    '
    tblIndex.Name = NDB_NET_TABLE_INDEX
    tblIndex.Unique = False
    tblIndex.Primary = True
    tblIndex.Fields = NDB_NET_TABLE_NODE

    ' Set the table name.
    '
    tblNetInfo.Name = NDB_NET_TABLE_NAME

    ' Initialize the fields.
    '
    fldNode.Name = NDB_NET_TABLE_NODE
    fldNode.Type = DB_TEXT
    fldNode.Size = 255
    tblNetInfo.Fields.Append fldNode

    fldText.Name = NDB_NET_TABLE_TEXT
    fldText.Type = DB_TEXT
    fldText.Size = 255
    tblNetInfo.Fields.Append fldText

    fldData1.Name = NDB_NET_TABLE_DATA1
    fldData1.Type = DB_TEXT
    fldData1.Size = 255
    tblNetInfo.Fields.Append fldData1

    fldData2.Name = NDB_NET_TABLE_DATA2
    fldData2.Type = DB_TEXT
    fldData2.Size = 255
    tblNetInfo.Fields.Append fldData2

    ' Add the index to the table and table to the database.
    '
    'tblNetInfo.Indexes.Append tblIndex
    dbDBase.TableDefs.Append tblNetInfo

    ' Clean Up.
    '
    dbDBase.Close
    Exit Sub

lblNewDBaseErr:
    MsgBox "Error creating blank database." & Chr(13) & Chr(10) & Error
    Exit Sub

    Resume Next
End Sub

Sub CreateDiagram (strFileName As String)
'----------------------------------------
'--- CreateDiagram ----------------------
'--
'--   Creates a network diagram from a database table.
'--
'-- Parameters : strFileName - Database file name
'--

    On Error GoTo lblCreateDiagramErr

    Dim strMsg As String
    Dim dbDBase As Database
    Dim pag As Object, shp As Object, mast As Object
    Dim NodeList() As NodeInfo

    ' First we try and initialize Visio

    If Not InitDiagram() Then Exit Sub

    ' Next we try and open the database.  Access should convert regardless of
    ' format.

    Set dbDBase = OpenDatabase(strFileName)

    ' No error occurred so we try and open our table.  We use a constant
    ' name for a database at this point but should prompt the user in the
    ' future for what table they want to use.

    Set m_tblNetInfo = dbDBase.OpenTable(NDB_NET_TABLE_NAME)

    ' Next we build the node list for drawing.

    BuildNodeList NodeList()

    ' Finally we are ready to build the diagram.

    m_tblNetInfo.MoveFirst

    If Not m_tblNetInfo.EOF Then
        DrawDiagram NodeList()
    Else
        MsgBox "Table is empty", MB_ICONINFORMATION, "Create Diagram"
    End If

    ' Cleanup by closing table and database and releasing their resources.

    m_tblNetInfo.Close
    dbDBase.Close

    Set m_tblNetInfo = Nothing

    MsgBox "Finished creating diagram.", MB_ICONINFORMATION, ""
    Exit Sub

lblCreateDiagramErr:
    strMsg = "Error creating network diagram." & Chr(13) & Chr(10)
    strMsg = strMsg & Error

    MsgBox strMsg, MB_ICONEXCLAMATION, "Error"
    Exit Sub

    Resume Next
End Sub

Sub DrawDiagram (NodeList() As NodeInfo)
'----------------------------------------
'--- DrawDiagram ------------------------
'--
'--   Builds the network diagram from the network info table.
'--
'-- Assumptions : InitDiagram succeeded and table is loaded in module
'--               m_tblNetInfo.
'--

    On Error GoTo lblBuildDiagramErr

    Dim iPinX As Double, iPinY As Double
    Dim iBus As Integer, iMaxBus As Integer
    Dim iHandle As Integer, iNode As Integer
    Dim strMsg As String, strCellName As String
    Dim X, Y, iRow As Integer

    Dim shp As Object, mast As Object, bus As Object, cell As Object
    Dim CHandle As VisPoint

    ' Next we loop through each node in the list and drop it on the page
    ' according to it's master name.  The drop information and master name
    ' were decided in BuildNodeList().
    '
    m_tblNetInfo.MoveFirst

    For iNode = 0 To UBound(NodeList)
        iPinX = NodeList(iNode).iPinX
        iPinY = NodeList(iNode).iPinY

        Set mast = m_masts(NodeList(iNode).strMaster)
        Set shp = m_pag.Drop(mast, iPinX, iPinY)

        shp.Text = "" & m_tblNetInfo.Fields(1)
        'shp.Data1 = "" & m_tblNetInfo.Fields(2)
        'shp.Data2 = "" & m_tblNetInfo.Fields(3)

        m_tblNetInfo.MoveNext
    Next iNode

    ' Lastly we draw the ethernet bus and attach it to the nodes.  Notice we
    ' hard code the number of control handles per bus at 5 (iMaxBus).
    '
    Set mast = m_masts(NDB_NET_ETHERNET)        ' Ethernet Bus Master

    iNode = 0                                   ' Current Network Node
    iMaxBus = Int((UBound(NodeList) + 1) / 5)   ' Total buses needed

    For iBus = 0 To iMaxBus
        ' Becuause the ethernet bus has a limited number of control handles we
        ' stack them on top of each other to make it appear like there is
        ' an unlimited number.  However, we must only use a fill on the bottom
        ' bus to make sure all control lines are seen and only leave the
        ' text on the top bus so it isn't overwritten by the control lines.
        '
        Set bus = m_pag.Drop(mast, 0, 0)        ' Draw Bus

        bus.SetBegin (NDB_PAGE_WIDTH / 2), 0
        bus.SetEnd (NDB_PAGE_WIDTH / 2), NDB_PAGE_HEIGHT

        If iBus <> 0 Then bus.FillStyle = "None"
        If iBus <> iMaxBus Then bus.Text = ""

        For iHandle = 1 To bus.RowCount(visSectionControls)
            iNode = iNode + 1

            If iNode <= (UBound(NodeList) + 1) Then
                ' If we have another node to glue to we simply get the node
                ' from the page.Shapes collections and glue to the side
                ' specified in it's NodeInfo using the next available control
                ' handle.
                '
                strCellName = "Controls.X" & LTrim(Str(iHandle))

                Set shp = m_pag.Shapes(iNode)

                iRow = BestExportPoint(shp, NodeList(iNode - 1).iSide)

                Set cell = shp.CellsSRC(visSectionExport, iRow - 1, 0)

                bus.Cells(strCellName).GlueTo cell
            Else
                GetCtrlHandlePt bus, (iHandle), CHandle

                CHandle.X = "LocPinX"
                CHandle.Y = "LocPinY"

                SetCtrlHandlePt bus, (iHandle), CHandle
            End If
        Next iHandle
    Next iBus

    Exit Sub

lblBuildDiagramErr:
    strMsg = "Error building network diagram." & Chr(13) & Chr(10) & Error
    MsgBox strMsg, MB_ICONEXCLAMATION, "Error"
    Exit Sub

    Resume Next
End Sub

Function InitDiagram () As Integer
'----------------------------------------
'--- InitDiagram ------------------------
'--
'--   Initializes diagram by getting the GIO, creating a new drawing and
'-- setting the pag object.  Also sets the page to landscape.
'--

    On Error GoTo lblInitDiagramErr

    Dim strAction As String

    InitDiagram = True

    ' First we try and get Visio up and running.
    '
    If vaoGetObject() <> visOK Then
        InitDiagram = False
        MsgBox "Error starting Visio", MB_ICONEXCLAMATION, "Error"
        Exit Function
    End If

    ' Next we try and create a document based on the network stencil.  Then
    ' we retrieve the masters from the network stencil.
    '
    strAction = "Opening stencil " & NDB_NET_STENCIL

    Set m_pag = g_appVisio.Documents.Add(NDB_NET_TEMPLATE).Pages(1)
    Set m_masts = g_appVisio.Documents(NDB_NET_STENCIL).Masters

    ' Next we make the page landscape.
    '
    strAction = "Updating page width and height."
    m_pag.Shapes("thePage").Cells("PageWidth").Formula = NDB_PAGE_WIDTH
    m_pag.Shapes("thePage").Cells("PageHeight").Formula = NDB_PAGE_HEIGHT

    Exit Function

lblInitDiagramErr:
    MsgBox "Error " & strAction, MB_ICONEXCLAMATION, "Error"
    InitDiagram = False
    Exit Function

    Resume Next
End Function

Function MatchMasterToType (ByVal strData As String) As String
'----------------------------------------
'--- MatchMasterToType ------------------
'--
'--    Given a node type will return a string containing the closest match
'-- for that type.  If no match can be determined it returns a match to a
'-- PC.
'--

    Dim strMatch As String, strType As String

    strType = strData
    strMatch = strType

    Select Case LCase(strType)
        Case LCase(NDB_NODE_MAC)
        Case LCase(NDB_NODE_PC)
        Case LCase(NDB_NODE_SERVER)
        Case LCase(NDB_NODE_WORKSTATION)
        Case LCase(NDB_NODE_TOWER)
        Case LCase(NDB_NODE_PRINTER)
        Case Else
            strMatch = ""
    End Select

    If strMatch = "" Then
        If InStr(1, strType, "tower", 1) Then
            strMatch = NDB_NODE_PC
        ElseIf InStr(1, strType, "apple", 1) Then
            strMatch = NDB_NODE_MAC
        ElseIf InStr(1, strType, "mac", 1) Then
            strMatch = NDB_NODE_MAC
        ElseIf InStr(1, strType, "ibm", 1) Then
            strMatch = NDB_NODE_PC
        ElseIf InStr(1, strType, "pc", 1) Then
            strMatch = NDB_NODE_PC
        ElseIf InStr(1, strType, "clone", 1) Then
            strMatch = NDB_NODE_PC
        ElseIf InStr(strType, "server") Then
            strMatch = NDB_NODE_PC
        ElseIf InStr(1, strType, "file", 1) Then
            strMatch = NDB_NODE_PC
        ElseIf InStr(1, strType, "desktop", 1) Then
            strMatch = NDB_NODE_PC
        Else
            strMatch = NDB_NODE_PC
        End If
    End If

    MatchMasterToType = strMatch
End Function

Function Max (X, Y)
    If X < Y Then
        Max = Y
    Else
        Max = X
    End If
End Function

Function Min (X, Y)
    If X < Y Then
        Min = X
    Else
        Min = Y
    End If
End Function

Function ValidDatabase (strFileName As String) As Integer
'----------------------------------------
'--- ValidDatabase ----------------------
'--
'--   Validates a database by opening it and verifying the a valid network
'-- diagramming table exists.
'--

    On Error GoTo lblValidDatabaseErr

    Dim dbDBase As Database
    Dim NetTable As Table

    ValidDatabase = True

    ' First we try and open the database.  Access should convert regardless of
    ' format.

    Set dbDBase = OpenDatabase(strFileName)

    ' No error occurred so we try and open our table.  We use a constant
    ' name for a database at this point but should prompt the user in the
    ' future for what table they want to use.

    Set NetTable = dbDBase.OpenTable(NDB_NET_TABLE_NAME)

    ' If Nothing is returned the table doesn't exist and we consider the
    ' database invalid.  If a table is returned we check to make sure it
    ' contains 4 fields:
    '
    ' Network Info Table Structure
    '   +-----------+-----------+-------------+-------------+
    '   | Node Type | Node Text | Node Data 1 | Node Data 2 |
    '   +-----------+-----------+-------------+-------------+

    If (NetTable Is Nothing) Or (NetTable.Fields.Count <> 4) Then
        ValidDatabase = False
    End If

    ' Cleanup by closing table and database.

    NetTable.Close
    dbDBase.Close

    Exit Function

lblValidDatabaseErr:
    ValidDatabase = False
    Exit Function

    Resume Next
End Function